Novel vs. repeated choice project: Psychometrics

Set up environment and load in data

Add columns that will be used for plots below.

data_yn_clean = data_yn_clean %>%
  mutate(correct = ifelse(possiblePayoff>reference & yesChosen == 1, 1, ifelse(possiblePayoff < reference & yesChosen == 0, 1, 0))) %>%
  mutate(type = ifelse(type == 1, "HT", "RE"),
         week = ifelse(week == 1, "Week 1", ifelse(week == 2, "Week 2", ifelse(week == 3, "Week 3", NA))),
         week = factor(week, levels = c("Week 1", "Week 2", "Week 3"))) %>%
  mutate(val_diff = possiblePayoff - reference,
         val_diff_bin = round(val_diff/50),
         val_diff_bin_str = ifelse(val_diff_bin == 0, "-50:50", 
                                   ifelse(val_diff_bin == 1, "50:100",
                                          ifelse(val_diff_bin == -1, "-100:-50",
                                                 ifelse(val_diff_bin == 2, "100:150",
                                                        ifelse(val_diff_bin == -2, "-150:-100",
                                                               ifelse(val_diff_bin == 3, "150:200",
                                                                      ifelse(val_diff_bin == -3, "-200:-150",
                                                                             ifelse(val_diff_bin == 4, "200:250", 
                                                                                    ifelse(val_diff_bin == -4, "-250:-200", NA))))))))),
         val_diff_bin_str = factor(val_diff_bin_str, levels = c("-250:-200", "-200:-150", "-150:-100", "-100:-50", "-50:50", "50:100", "100:150", "150:200", "200:250")))

data_bc_clean = data_bc_clean %>%
  mutate(correct = ifelse(possiblePayoffleft>possiblePayoffright & leftChosen == 1, 1, ifelse(possiblePayoffleft<possiblePayoffright & leftChosen == 0, 1, 0))) %>%
  mutate(type = ifelse(typeLeft == 1, "HT", "RE"),
         week = ifelse(week == 1, "Week 1", ifelse(week == 2, "Week 2", ifelse(week == 3, "Week 3", NA))),
         week = factor(week, levels = c("Week 1", "Week 2", "Week 3"))) %>%
  mutate(val_diff = possiblePayoffleft - possiblePayoffright,
         val_diff_bin = round(val_diff/50),
         val_diff_bin_str = ifelse(val_diff_bin == 0, "-50:50", 
                                   ifelse(val_diff_bin == 1, "50:100",
                                          ifelse(val_diff_bin == -1, "-100:-50",
                                                 ifelse(val_diff_bin == 2, "100:150",
                                                        ifelse(val_diff_bin == -2, "-150:-100",
                                                               ifelse(val_diff_bin == 3, "150:200",
                                                                      ifelse(val_diff_bin == -3, "-200:-150",
                                                                             ifelse(val_diff_bin == 4, "200:250", 
                                                                                    ifelse(val_diff_bin == -4, "-250:-200", 
                                                                                           ifelse(val_diff_bin == 5, "250:300",
                                                                                                  ifelse(val_diff_bin == -5, "-300:-250", NA))))))))))),
         val_diff_bin_str = factor(val_diff_bin_str, levels = c("-300:-250", "-250:-200", "-200:-150", "-150:-100", "-100:-50", "-50:50", "50:100", "100:150", "150:200", "200:250", "250:300")))

Accuracy over days

YN Task

p = data_yn_clean %>%
  group_by(subnum, day, type) %>%
  summarise(mean_correct = mean(correct),
            sem_correct = sd(correct)/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(day, mean_correct, color=type))+
  geom_point()+
  geom_errorbar(aes(ymin=mean_correct-sem_correct, ymax=mean_correct+sem_correct), width=0)+
  geom_line()+
  facet_wrap(~subnum)+
  labs(x = "Day", y = "Accuracy", title="Y/N Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        legend.box.margin=margin(t = -10))+
  scale_x_continuous(breaks=seq(1,11,1))+
  scale_color_brewer(palette = "Dark2")
p

# ggsave(file=paste0(fig_out_path, 'yn_accuracyOverDays.jpg'), p, height = 5, width=8, units="in")

BC Task

p = data_bc_clean %>%
  group_by(subnum, day, type) %>%
  summarise(mean_correct = mean(correct),
            sem_correct = sd(correct)/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(day, mean_correct, color=type))+
  geom_point()+
  geom_errorbar(aes(ymin=mean_correct-sem_correct, ymax=mean_correct+sem_correct), width=0)+
  geom_line()+
  facet_wrap(~subnum)+
  labs(x = "Day", y = "Accuracy", title="BC Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        legend.box.margin=margin(t = -10))+
  scale_x_continuous(breaks=seq(1,11,1))+
  scale_color_brewer(palette = "Dark2")

p

# ggsave(file=paste0(fig_out_path, 'bc_accuracyOverDays.jpg'), p, height = 5, width=8, units="in")

Accuracy depending on value difference

YN Task

p = data_yn_clean %>%
  group_by(subnum, week, val_diff_bin_str, type) %>%
  summarise(mean_correct = mean(correct),
            sem_correct = sd(correct)/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(val_diff_bin_str, mean_correct, color=type))+
  # geom_point()+
  geom_jitter(width=.2)+
  geom_errorbar(aes(ymin=mean_correct-sem_correct, ymax=mean_correct+sem_correct), width=0)+
  geom_line(aes(group=type))+
  facet_grid(subnum~week)+
  labs(x = "Value Stim - Value Reference", y = "Accuracy", title="Y/N Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        axis.text.x = element_text(angle = 15, margin = margin(t = 5)),
        legend.box.margin=margin(t = -10))+
  scale_color_brewer(palette = "Dark2")+
  scale_x_discrete(labels=c("-250:-200", "", "-150:-100", "", "-50:50", "", "100:150", "", "200:250"))+
  scale_y_continuous(breaks = seq(.6,1,.2))

p

# ggsave(file=paste0(fig_out_path, 'yn_accuracyByValDiff.jpg'), p, height = 7, width=8, units="in")

BC Task

p = data_bc_clean %>%
  filter(abs(val_diff_bin) != 6) %>%
  group_by(subnum, week, val_diff_bin_str, type) %>%
  summarise(mean_correct = mean(correct),
            sem_correct = sd(correct)/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(val_diff_bin_str, mean_correct, color=type))+
  # geom_point()+
  geom_jitter(width=.2)+
  geom_errorbar(aes(ymin=mean_correct-sem_correct, ymax=mean_correct+sem_correct), width=0)+
  geom_line(aes(group=type))+
  facet_grid(subnum~week)+
  labs(x = "Value Left - Value Right", y = "Accuracy", title="BC Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        axis.text.x = element_text(angle = 15, margin = margin(t = 5)),
        legend.box.margin=margin(t = -10))+
  scale_color_brewer(palette = "Dark2")+
  scale_x_discrete(labels=c("", "-250:-200", "", "-150:-100", "", "-50:50", "", "100:150", "", "200:250", ""))+
  scale_y_continuous(breaks = seq(.25,1,.25))

p

# ggsave(file=paste0(fig_out_path, 'bc_accuracyByValDiff.jpg'), p, height = 7, width=8, units="in")

Yes/Left depending on value difference

YN Task

p = data_yn_clean %>%
  group_by(subnum, week, val_diff_bin_str, type) %>%
  summarise(mean_yes = mean(yesChosen),
            sem_yes = sd(yesChosen)/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(val_diff_bin_str, mean_yes, color=type))+
  # geom_point()+
  geom_jitter(width=.2)+
  geom_errorbar(aes(ymin=mean_yes-sem_yes, ymax=mean_yes+sem_yes), width=0)+
  geom_line(aes(group=type))+
  facet_grid(subnum~week)+
  geom_hline(aes(yintercept=.5), color="gray", linetype = "longdash")+
  geom_vline(aes(xintercept=5), color="gray", linetype = "longdash")+
  labs(x = "Value Stim - Value Reference", y = "p(Yes)", title="Y/N Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        axis.text.x = element_text(angle = 15, margin = margin(t = 5)),
        legend.box.margin=margin(t = -10))+
  scale_color_brewer(palette = "Dark2")+
  scale_x_discrete(labels=c("-250:-200", "", "-150:-100", "", "-50:50", "", "100:150", "", "200:250"))+
  scale_y_continuous(breaks = seq(0,1,.5))

p

# ggsave(file=paste0(fig_out_path, 'yn_pYesByValDiff.jpg'), p, height = 7, width=8, units="in")

p = data_yn_clean %>%
  filter(fmri==1) %>%
  group_by(subnum, day, val_diff_bin_str, type) %>%
  summarise(mean_yes = mean(yesChosen),
            sem_yes = sd(yesChosen)/sqrt(n()),
            .groups="keep") %>%
  mutate(day = paste0("Day ", day),
         day = factor(day, levels  = c("Day 3", "Day 7", "Day 11"))) %>%
  ggplot(aes(val_diff_bin_str, mean_yes, color=type))+
  # geom_point()+
  geom_jitter(width=.2)+
  geom_errorbar(aes(ymin=mean_yes-sem_yes, ymax=mean_yes+sem_yes), width=0)+
  geom_line(aes(group=type))+
  facet_grid(subnum~day)+
  geom_hline(aes(yintercept=.5), color="gray", linetype = "longdash")+
  geom_vline(aes(xintercept=5), color="gray", linetype = "longdash")+
  labs(x = "Value Stim - Value Reference", y = "p(Yes)", title="Y/N Task (fMRI sessions)", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        axis.text.x = element_text(angle = 15, margin = margin(t = 5)),
        legend.box.margin=margin(t = -10))+
  scale_color_brewer(palette = "Dark2")+
  scale_x_discrete(labels=c("-250:-200", "", "-150:-100", "", "-50:50", "", "100:150", "", "200:250"))+
  scale_y_continuous(breaks = seq(0,1,.5))

p

# ggsave(file=paste0(fig_out_path, 'yn_pYesByValDiffMRI.jpg'), p, height = 7, width=8, units="in")

BC Task

p = data_bc_clean %>%
  filter(abs(val_diff_bin) != 6) %>%
  group_by(subnum, week, val_diff_bin_str, type) %>%
  summarise(mean_left = mean(leftChosen),
            sem_left = sd(leftChosen)/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(val_diff_bin_str, mean_left, color=type))+
  # geom_point()+
  geom_jitter(width=.2)+
  geom_errorbar(aes(ymin=mean_left-sem_left, ymax=mean_left+sem_left), width=0)+
  geom_line(aes(group=type))+
  facet_grid(subnum~week)+
  geom_hline(aes(yintercept=.5), color="gray", linetype = "longdash")+
  geom_vline(aes(xintercept=6), color="gray", linetype = "longdash")+
  labs(x = "Value Left - Value Right", y = "p(Left)", title="BC Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        axis.text.x = element_text(angle = 15, margin = margin(t = 5)),
        legend.box.margin=margin(t = -10))+
  scale_color_brewer(palette = "Dark2")+
  scale_x_discrete(labels=c("", "-250:-200", "", "-150:-100", "", "-50:50", "", "100:150", "", "200:250", ""))+
  scale_y_continuous(breaks = seq(0,1,.5))

p

# ggsave(file=paste0(fig_out_path, 'bc_pLeftByValDiff.jpg'), p, height = 7, width=8, units="in")

p = data_bc_clean %>%
  filter(abs(val_diff_bin) != 6) %>%
  filter(fmri==1) %>%
  group_by(subnum, day, val_diff_bin_str, type) %>%
  summarise(mean_left = mean(leftChosen),
            sem_left = sd(leftChosen)/sqrt(n()),
            .groups="keep") %>%
  mutate(day = paste0("Day ", day),
         day = factor(day, levels  = c("Day 3", "Day 7", "Day 11"))) %>%
  ggplot(aes(val_diff_bin_str, mean_left, color=type))+
  # geom_point()+
  geom_jitter(width=.2)+
  geom_errorbar(aes(ymin=mean_left-sem_left, ymax=mean_left+sem_left), width=0)+
  geom_line(aes(group=type))+
  facet_grid(subnum~day)+
  geom_hline(aes(yintercept=.5), color="gray", linetype = "longdash")+
  geom_vline(aes(xintercept=6), color="gray", linetype = "longdash")+
  labs(x = "Value Left - Value Right", y = "p(Left)", title="BC Task (fMRI sessions)", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        axis.text.x = element_text(angle = 15, margin = margin(t = 5)),
        legend.box.margin=margin(t = -10))+
  scale_color_brewer(palette = "Dark2")+
  scale_x_discrete(labels=c("", "-250:-200", "", "-150:-100", "", "-50:50", "", "100:150", "", "200:250", ""))+
  scale_y_continuous(breaks = seq(0,1,.5))

p

# ggsave(file=paste0(fig_out_path, 'bc_pLeftByValDiffMRI.jpg'), p, height = 7, width=8, units="in")

RT over days

YN Task

p = data_yn_clean %>%
  group_by(subnum, day, type) %>%
  summarise(mean_log_rt = mean(log(rt)),
            sem_log_rt = sd(log(rt))/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(day, mean_log_rt, color=type))+
  geom_point()+
  geom_errorbar(aes(ymin=mean_log_rt-sem_log_rt, ymax=mean_log_rt+sem_log_rt), width=0)+
  geom_line()+
  facet_wrap(~subnum)+
  labs(x = "Day", y = "Mean Log RT", title="Y/N Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        legend.box.margin=margin(t = -10))+
  scale_x_continuous(breaks=seq(1,11,1))+
  scale_color_brewer(palette = "Dark2")

p

# ggsave(file=paste0(fig_out_path, 'yn_RTOverDays.jpg'), p, height = 5, width=8, units="in")

BC Task

p = data_bc_clean %>%
  group_by(subnum, day, type) %>%
  summarise(mean_log_rt = mean(log(rt)),
            sem_log_rt = sd(log(rt))/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(day, mean_log_rt, color=type))+
  geom_point()+
  geom_errorbar(aes(ymin=mean_log_rt-sem_log_rt, ymax=mean_log_rt+sem_log_rt), width=0)+
  geom_line()+
  facet_wrap(~subnum)+
  labs(x = "Day", y = "Mean Log RT", title="BC Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        legend.box.margin=margin(t = -10))+
  scale_x_continuous(breaks=seq(1,11,1))+
  scale_color_brewer(palette = "Dark2")

p

# ggsave(file=paste0(fig_out_path, 'bc_RTOverDays.jpg'), p, height = 5, width=8, units="in")

RT depending on value difference

YN Task

p = data_yn_clean %>%
  group_by(subnum, week, val_diff_bin_str, type) %>%
  summarise(mean_log_rt = mean(log(rt)),
            sem_log_rt = sd(log(rt))/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(val_diff_bin_str, mean_log_rt, color=type))+
  # geom_point()+
  geom_jitter(width=.2)+
  geom_errorbar(aes(ymin=mean_log_rt-sem_log_rt, ymax=mean_log_rt+sem_log_rt), width=0)+
  geom_line(aes(group=type))+
  facet_grid(subnum~week)+
  labs(x = "Value Stim - Value Reference", y = "Mean Log RT", title="Y/N Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        axis.text.x = element_text(angle = 15, margin = margin(t = 5)),
        legend.box.margin=margin(t = -10))+
  scale_color_brewer(palette = "Dark2")+
  scale_x_discrete(labels=c("-250:-200", "", "-150:-100", "", "-50:50", "", "100:150", "", "200:250"))+
  scale_y_continuous(breaks = seq(-1,.5,.5))

p

# ggsave(file=paste0(fig_out_path, 'yn_RTOverValDiff.jpg'), p, height = 5, width=8, units="in")

BC Task

p = data_bc_clean %>%
  filter(abs(val_diff_bin) != 6) %>%
  group_by(subnum, week, val_diff_bin_str, type) %>%
  summarise(mean_log_rt = mean(log(rt)),
            sem_log_rt = sd(log(rt))/sqrt(n()),
            .groups="keep") %>%
  ggplot(aes(val_diff_bin_str, mean_log_rt, color=type))+
  geom_point()+
  geom_errorbar(aes(ymin=mean_log_rt-sem_log_rt, ymax=mean_log_rt+sem_log_rt), width=0)+
  geom_line(aes(group=type))+
  facet_grid(subnum~week)+
  labs(x = "Value Left - Value Right", y = "Accuracy", title="BC Task", color="")+
  theme(panel.grid = element_blank(),
        legend.position = "bottom",
        axis.text.x = element_text(angle = 15, margin = margin(t = 5)),
        legend.box.margin=margin(t = -10))+
  scale_color_brewer(palette = "Dark2")+
  scale_x_discrete(labels=c("", "-250:-200", "", "-150:-100", "", "-50:50", "", "100:150", "", "200:250", ""))+
  scale_y_continuous(breaks = seq(-1,.5,.5))

p

# ggsave(file=paste0(fig_out_path, 'bc_RTOverValDiff.jpg'), p, height = 5, width=8, units="in")

Fixation Cross Free RT

What does the distribution of free RTs during the fixation look like?

YN Task

For task_beah (non-fmri sessions) startFix is when the fixation comes on

yn_fix_rt_data = data_yn_clean %>%
  filter(fmri == 0) %>%
  select(-evtimeON, -evtimeOFF, -fmri, -response, -valueO, -valueF, -valueS, -stimNum, -crossON) %>%
  group_by(subnum, day, session) %>%
  mutate(trialNum = 1:n(),
         startFixDiff = c(diff(startFix), NA), 
         rewardTime = ifelse(session == 1 & trialNum < 16, 2.4, ifelse(session == 1 & trialNum > 15 & trialNum < 36, 1.5, 1))) %>%
  filter(!is.na(startFixDiff)) %>%
  mutate(fixRt = startFixDiff - (rt+rewardTime))

There are some very long RTs during the fixation cross

summary(yn_fix_rt_data$fixRt)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##   0.1421   0.1635   0.2822   0.3571   0.4273 293.6797

But less than 2% of all trials have fixations RTs slower than 1 second.

sum(yn_fix_rt_data$fixRt>1)/nrow(yn_fix_rt_data)

## [1] 0.01923715

Excluding slow fixation RTs for the plot

yn_fix_rt_data %>%
  filter(fixRt < 1) %>%
  ggplot(aes(fixRt))+
  geom_histogram(alpha=.5, bins=30)+
  facet_wrap(~subnum)+
  theme(panel.grid = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank())+
  labs(y="", x = "Fixation Cross RT", title = "Y/N Task")

yn_fix_rt_data %>%
  filter(fixRt < 1) %>%
  ungroup() %>%
  group_by(subnum, day) %>%
  summarise(.groups="keep",
            mean_log_fix_rt = mean(log(fixRt)),
            sem_log_fix_rt = sd(log(fixRt))/sqrt(n())) %>%
  ggplot(aes(day, mean_log_fix_rt))+
  geom_point()+
  geom_errorbar(aes(ymin=mean_log_fix_rt - sem_log_fix_rt, ymax = mean_log_fix_rt + sem_log_fix_rt), width= 0)+
  geom_line()+
  facet_wrap(~subnum)+
  theme(panel.grid = element_blank())+
  labs(x="Day", y = "Mean Log Fixation Cross RT", title = "Y/N Task")+
  scale_x_continuous(breaks=seq(1,11,1))

## BC Task

bc_fix_rt_data = data_bc_clean %>%
  filter(fmri == 0) %>%
  select(subnum, day, rt, startFix) %>%
  group_by(subnum, day) %>%
  mutate(trialNum = 1:n(),
         startFixDiff = c(diff(startFix), NA), 
         rewardTime = 1.1) %>%
  filter(!is.na(startFixDiff)) %>%
  mutate(fixRt = startFixDiff - (rt+rewardTime))

summary(bc_fix_rt_data$fixRt)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.1416  0.1690  0.2395  0.3394  0.4158 66.9632

But less than 2% of all trials have fixations RTs slower than 1 second.

sum(bc_fix_rt_data$fixRt>1)/nrow(bc_fix_rt_data)

## [1] 0.01967531

Excluding slow fixation RTs for the plot

bc_fix_rt_data %>%
  filter(fixRt < 1) %>%
  ggplot(aes(fixRt))+
  geom_histogram(alpha=.5, bins=30)+
  facet_wrap(~subnum)+
  theme(panel.grid = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank())+
  labs(y="", x = "Fixation Cross RT", title = "BC Task")

bc_fix_rt_data %>%
  filter(fixRt < 1) %>%
  ungroup() %>%
  group_by(subnum, day) %>%
  summarise(.groups="keep",
            mean_log_fix_rt = mean(log(fixRt)),
            sem_log_fix_rt = sd(log(fixRt))/sqrt(n())) %>%
  ggplot(aes(day, mean_log_fix_rt))+
  geom_point()+
  geom_errorbar(aes(ymin=mean_log_fix_rt - sem_log_fix_rt, ymax = mean_log_fix_rt + sem_log_fix_rt), width= 0)+
  geom_line()+
  facet_wrap(~subnum)+
  theme(panel.grid = element_blank())+
  labs(x="Day", y = "Mean Log Fixation Cross RT", title = "BC Task")+
  scale_x_continuous(breaks=seq(1,11,1))